home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qphelp.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  6.9 KB  |  192 lines
  1. ;;; SCCS: @(#)90/09/25 qphelp.el    2.8
  2. ;;;            Quintus Prolog - GNU Emacs Interface
  3. ;;;                         Support Functions
  4. ;;;
  5. ;;;                Consolidated by Sitaram Muralidhar
  6. ;;;
  7. ;;;                   sitaram@quintus.com
  8. ;;;              Quintus Computer Systems, Inc.
  9. ;;;                  2 May 1989       
  10. ;;;
  11. ;;; This file defines functions that support the Quintus Prolog - GNU Emacs
  12. ;;; interface.
  13. ;;;
  14. ;;;                   Acknowledgements
  15. ;;;
  16. ;;; This interface was made possible by contributions from Fernando 
  17. ;;; Pereira and various customers of Quintus Computer Systems, Inc.,
  18. ;;; based on code for Quintus's Unipress Emacs interface. 
  19. ;;; 
  20. ;;; Note: there may be a problem using Quintus Prolog help under X windows.
  21. ;;; If the emacs window is resized or moved after help is invocated, restoring
  22. ;;; the previous window  configuration will result in an error. 
  23.  
  24. (provide 'qphelp)
  25. (qprequire 'qphelp-functions)
  26.  
  27. ; Quintus Prolog Help System file types.
  28. ;
  29. (defconst MENU "{menu}")
  30. (defconst TEXT "{text}")
  31. (defconst SHELL "{shell}")
  32. (defconst HELP "{help}")
  33. (defconst Prolog-buffer "*prolog*")
  34.  
  35. ; Constants
  36. ;
  37. (defconst NOERROR t)
  38. (defconst EMPTY '())
  39.  
  40. ; Initialize Variables.
  41. ;
  42. (defvar *state* '() 
  43.   "List of buffer states, i.e. (current-buffer point).")
  44. (defvar current-file nil 
  45.   "The help file we are now looking for; used for error reporting.")
  46. (defvar Quintus-help-key-map nil "Local keymap for Prolog menu help.")
  47. (defvar Quintus-text-key-map nil "Local keymap for Prolog text help.")
  48.  
  49. ; buffer:
  50. ;    Quintus-help-system: for help and text interaction.
  51. ;
  52. (defvar Quintus-help-system "*Quintus-Help-System*" 
  53.   "Buffer name used during a Quintus Prolog help session.")
  54.  
  55. (defmacro error-occurred (&rest body)
  56.   (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
  57.  
  58. (defun push-state (buffer point)
  59.   "Save the current buffer and point location."
  60.   (setq *state* (append (list (cons buffer point)) *state*)))
  61.  
  62. (defun pop-state ()
  63.   "pop to the most recent buffer. If we are returning to the 
  64.    top level, return the point to the end of the buffer."
  65.   (kill-buffer (current-buffer))
  66.   (while (error-occurred (pop-to-buffer (car (car *state*)))) 
  67.                     ; in case intermediate buffers have been killed
  68.     (setq *state*  (cdr *state*)))
  69.   (if  (equal (buffer-name (car (car *state*))) "*prolog*")
  70.        (goto-char (point-max))            ; then part
  71.        (goto-char     (cdr (car *state*))))  ; else part
  72.   (setq *state*  (cdr *state*)))
  73.   
  74. (defun initialize-state ()
  75.   "Initilize variables with each invocation from Quintus Prolog."
  76.   (if (string-equal (buffer-name) Prolog-buffer)
  77.       (setq *state* '())))
  78.  
  79. (defun @help (file)
  80.   "Help executive for Quintus Prolog."
  81.   (initialize-state)
  82.   (push-state (current-buffer) (point))
  83.   (process-file file))
  84.  
  85. (defun @manual (file)
  86.   "Manual executive for Quintus Prolog."
  87.   (initialize-state)
  88.   (push-state (current-buffer) (point))
  89.   (process-file file))
  90.  
  91. (defun process-file (file)
  92.   "Process a help or manual query from Quintus Prolog"
  93.   (switch-to-buffer-other-window (generate-new-buffer Quintus-help-system))
  94.   (erase-buffer)
  95.   (if (error-occurred (insert-file file)) ;read the file into an empty buffer
  96.       (message "%s" (concat "There is no information "
  97.                 "currently available on this topic."))
  98.     (progn (setq current-file file) ; save current file for error reporting
  99.        (goto-char (point-min))  ; goto top of file
  100.        (initialize))))          ; initialize the window
  101.  
  102. (defun initialize () 
  103.   "Initiailzations performed on entry to a buffer. Different actions are 
  104.    performed depending whether the file is {menu} or {text}."
  105.   (cond ((file-type MENU) (progn 
  106.                 (delete-type-marker)   ;remove the type marker
  107.                 (define-local-key-map MENU) ;define local key map
  108.                 (find-next-entry)))  ;go to first entry
  109.     ((file-type TEXT) (progn 
  110.                 (delete-type-marker) ;delete type marker
  111.                 (define-local-key-map TEXT))) ;define local key map
  112.     (t (message "%s" (concat "error malformed help/manual "
  113.                  "file: type marker not found."))))
  114.   (toggle-read-only))
  115.  
  116. (defun define-local-key-map (type)
  117.   "Select a key map for either menu or text files."
  118.   (cond ((string-equal type MENU) 
  119.      (progn 
  120.        (Define-Quintus-help-keys)
  121.        (use-local-map Quintus-help-key-map)))
  122.     ((string-equal type TEXT) 
  123.      (progn 
  124.        (Define-Quintus-text-keys)
  125.        (use-local-map Quintus-text-key-map)))
  126.         ((string-equal type SHELL)
  127.      (progn 
  128.        (Define-Quintus-help-keys)
  129.        (use-local-map Quintus-help-key-map)))
  130.     (t (message "define-local-key-map: illegal map specifer: %s", type))))
  131.  
  132. (defun Define-Quintus-help-keys ()
  133.   (if (equal Quintus-help-key-map nil)
  134.       (progn 
  135.     (setq Quintus-help-key-map (make-keymap))
  136.     (suppress-keymap Quintus-help-key-map)    
  137.     (Quintus-help-key-map))))
  138.  
  139. (defun Define-Quintus-text-keys ()
  140.   (if (equal Quintus-text-key-map nil)
  141.       (progn 
  142.     (setq Quintus-text-key-map (make-keymap))
  143.     (suppress-keymap Quintus-text-key-map)
  144.     (Quintus-text-key-map))))
  145.  
  146. (defun Quintus-text-key-map ()
  147.   "Define the local key for The Quintus Prolog Text System."
  148.   (define-key Quintus-text-key-map "q"      'stop-it)
  149.   (define-key Quintus-text-key-map "b"      'back-one-step)
  150.   (define-key Quintus-text-key-map "u"      'up-one-level)
  151.   (define-key Quintus-text-key-map "?"      'get-text-help)
  152.   (define-key Quintus-text-key-map "x"      'find-next-reference)
  153.   (define-key Quintus-text-key-map "X"      'find-previous-reference)
  154.   (define-key Quintus-text-key-map "\C-l"   'redraw-display)
  155.   (define-key Quintus-text-key-map "\C-m"   'retrieve-next-reference)
  156.   (define-key Quintus-text-key-map "\C-v"   'next-page)
  157.   (define-key Quintus-text-key-map "\e\C-v" 'previous-page)
  158.   (define-key Quintus-text-key-map "\ez"    'scroll-one-line-up)
  159.   (define-key Quintus-text-key-map "\e\C-z" 'scroll-one-line-down)
  160.   (define-key Quintus-text-key-map " "      'scroll-up)
  161.   (define-key Quintus-text-key-map "\C-?"   'scroll-down)
  162.   (define-key Quintus-text-key-map "<"      'beginning-of-buffer)
  163.   (define-key Quintus-text-key-map ">"      'end-of-buffer))
  164.  
  165. (defun Quintus-help-key-map ()  
  166.   "Define the local key map for The Quintus Prolog Help System."
  167.   (define-key Quintus-help-key-map " "      'find-next-entry)
  168.   (define-key Quintus-help-key-map "\C-m"   'get-entry)
  169.   (define-key Quintus-help-key-map "\C-?"   'find-previous-entry)
  170.   (define-key Quintus-help-key-map "q"      'stop-it)
  171.   (define-key Quintus-help-key-map "u"      'up-one-level)
  172.   (define-key Quintus-help-key-map "b"      'back-one-step)
  173.   (define-key Quintus-help-key-map "?"      'get-menu-help)
  174.   (define-key Quintus-help-key-map "\C-l"   'redraw-display))
  175.  
  176. (defun delete-type-marker () 
  177.   "Delete the type marker. Function 'delete-type-marker' assumes the
  178.    existence of the type marker has been verified with 'file-type'."    
  179.   (goto-char (point-max))
  180.   (forward-line -1)
  181.   (kill-line 1)
  182.   (goto-char (point-min)))
  183.  
  184. (defun file-type (type)
  185.   "Find the type marker: {menu} or {text}."
  186.   (goto-char (point-max))
  187.   (forward-line -1)
  188.   (beginning-of-line)
  189.   (cond ((search-forward type nil NOERROR) (goto-char (point-min)))
  190.     (t (not (goto-char (point-min))))))
  191.  
  192.